home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-0039 / source / dcfileio.mod < prev    next >
Text File  |  1997-04-16  |  36KB  |  1,084 lines
  1. IMPLEMENTATION MODULE DCFileIO;
  2.  
  3.  
  4. (*---------------------------------------------------------------------*)
  5. (*   File I/O module for DegasConvert                                  *)
  6. (*                                                                     *)
  7. (*   Functions:                                                        *)
  8. (*      Load & Save Degas Format Pictures                              *)
  9. (*      Load 'TNY' format pictures                                     *)
  10. (*      Load 'TN*' format pictures                                     *)
  11. (*                                                                     *)
  12. (*      Save image file.                                               *)
  13. (*                                                                     *)
  14. (* Amendments:                                                         *)
  15. (* 25/ 9/89 LGM : Added conversion of compressed degas and LOGO        *)
  16. (*                pictures.                                            *)
  17. (* 26/ 8/89 LGM : Add Loading of DOODLE, NEO and then try and load     *)
  18. (*                anything else as degas format.                       *)
  19. (*                                                                     *)
  20. (*   Version 2.01     November 1988                  L.G. Miller       *)
  21. (*   Version 2.0      July     1988                  L.G. Miller       *)
  22. (*   Version 1.1      August   1987                  L.G.M.            *)
  23. (*---------------------------------------------------------------------*)
  24.  
  25. (*---------------------------------------------------------------------*)
  26. (*                         Import List                                 *)
  27. (*---------------------------------------------------------------------*)
  28.  
  29. (* IMPORT Trace; *)
  30.  
  31. FROM  DCGlobal     IMPORT DegasPicture, BitPlanesEnum,
  32.                           LowRes, LowResMaxX, LowResMaxY, LowResNoPlanes,
  33.                           MedRes, MedResMaxX, MedResMaxY, MedResNoPlanes,
  34.                           HiRes,  HiResMaxX,  HiResMaxY,  HiResNoPlanes,
  35.  
  36.               BITSPERWORD;
  37.  
  38. FROM IntLogic       IMPORT IOR, IAND;    
  39.  
  40. IMPORT Forms;
  41.  
  42. FROM SYSTEM        IMPORT ADR, ADDRESS,  BYTE;
  43.  
  44. FROM Storage       IMPORT ALLOCATE, DEALLOCATE, Available;
  45.  
  46. FROM Strings       IMPORT String, Concat, Length, Assign
  47.                           Pos, PosLast, Copy, Delete;
  48.  
  49. IMPORT GemDos;
  50.  
  51. FROM MyFileSelector  IMPORT GetFilename, ParseFilePath;
  52. (*
  53.       GetFilename ( VAR DefaultExtension      : ARRAY OF CHAR; (* input  *)
  54.                         VAR DefaultPathname   : ARRAY OF CHAR; (* i/o    *)
  55.                         VAR SelectedFilename  : ARRAY OF CHAR; (* i/o    *)
  56.                         VAR CompleteFilename  : ARRAY OF CHAR  (* output *)
  57.                       ) : BOOLEAN ;
  58.  
  59. *)
  60.  
  61. FROM ManyWindow     IMPORT ShowAlert, ShowMouse, HideMouse;
  62.  
  63. (*-----------------------------------------------------------------------*)
  64. (*                      Global Constants                                 *)
  65. (*-----------------------------------------------------------------------*)
  66.  
  67. CONST
  68.    CMaxTnyFile          = CARDINAL(40000);
  69.    CmaxIMGFile          = CMaxTnyFile;
  70.    CLongZero            = LONGCARD(0);
  71.  
  72.    CMaxExtensions       = 20;
  73.  
  74. TYPE
  75.   LowResPlaneChar  = ARRAY [ BitPlane1 .. BitPlane4 ] 
  76.             OF ARRAY [ 0 .. 1 ] OF CHAR;
  77.  
  78.   MedResPlaneChar  = ARRAY [ BitPlane1 .. BitPlane2 ] OF 
  79.             ARRAY [ 0 .. 1 ] OF CHAR;
  80.  
  81.   HiResPlaneChar   = ARRAY [ 0 .. 1 ] OF CHAR;
  82.  
  83.  
  84.    PicTypes = ( degas, smalldegas, logo, neo, doodle, tny, unknown );
  85.  
  86.    FileExtStr = ARRAY [ 0 .. 3 ] OF CHAR;
  87.  
  88.    FileType = RECORD
  89.         Type     : PicTypes;
  90.         FileExt : FileExtStr;
  91.    END;
  92.  
  93.    FileTypes     = ARRAY [ 0 .. CMaxExtensions ] OF FileType;
  94.  
  95.    TnyFileRange = [ 0 .. CMaxTnyFile ];
  96.  
  97.    TnyFile     = ARRAY TnyFileRange OF CHAR;
  98.  
  99.    TnyFilePtr     = POINTER TO TnyFile;
  100.  
  101.    WordArray      = ARRAY [ 0 .. 16000 ] OF BITSET; (* converted tny data *)
  102.  
  103.    WordArrayPtr = POINTER TO WordArray;
  104.  
  105.    CharPtr    = POINTER TO CHAR;
  106.  
  107. (*-----------------------------------------------------------------------*)
  108. (*                      Global Variables                                 *)
  109. (*-----------------------------------------------------------------------*)
  110.  
  111. VAR
  112.    LastFilename : String; (* store selected pathname for next time *)
  113.  
  114.    KnownFileTypes : FileTypes;
  115.  
  116. (*-----------------------------------------------------------------------*)
  117. (*                      Subroutines                                      *)
  118. (*-----------------------------------------------------------------------*)
  119.  
  120. PROCEDURE NullFill ( VAR s : ARRAY OF CHAR );
  121.   VAR i : CARDINAL;
  122.   BEGIN
  123.     FOR i := 0 TO SHORT(HIGH(s)) DO s[i] := 0C END;
  124.   END NullFill;
  125.  
  126.  
  127. PROCEDURE ClearPicture( VAR pic : DegasPicture );
  128.   VAR line, pg : CARDINAL;
  129.   BEGIN
  130.     FOR line := 0 TO HiResMaxY DO
  131.       FOR pg := 0 TO HIGH(pic.HiResPicture[0]) DO
  132.         pic.HiResPicture[line][pg] := BITSET(0H);
  133.       END;
  134.     END;
  135.   END ClearPicture;
  136.  
  137. (*-----------------------------------------------------------------------*)
  138. (*  Initialise known FileTypes array                                     *)
  139. (*                                                   *)
  140. (*  Note: MUST always be at least ONE Null entry in KnownFileTypesArray. *)
  141. (*-----------------------------------------------------------------------*)
  142.  
  143. PROCEDURE InitKnownFileTypes;
  144.   VAR i : CARDINAL;
  145.   BEGIN
  146.     FOR i := 0 TO CMaxExtensions DO 
  147.        NullFill(KnownFileTypes[i].FileExt);
  148.        KnownFileTypes[i].Type := unknown;
  149.     END;
  150.     i := 0;
  151.     WITH KnownFileTypes[i] DO Assign('PI1',FileExt); Type:= degas; END; INC(i);
  152.     WITH KnownFileTypes[i] DO Assign('PI2',FileExt); Type:= degas; END; INC(i);
  153.     WITH KnownFileTypes[i] DO Assign('PI3',FileExt); Type:= degas; END; INC(i);
  154.     WITH KnownFileTypes[i] DO Assign('TNY',FileExt); Type:= tny;   END; INC(i);
  155.     WITH KnownFileTypes[i] DO Assign('TN1',FileExt); Type:= tny;   END; INC(i);
  156.     WITH KnownFileTypes[i] DO Assign('TN2',FileExt); Type:= tny;   END; INC(i);
  157.     WITH KnownFileTypes[i] DO Assign('TN3',FileExt); Type:= tny;   END; INC(i);
  158.     WITH KnownFileTypes[i] DO Assign('TN3',FileExt); Type:= tny;   END; INC(i);
  159.     WITH KnownFileTypes[i] DO Assign('NEO',FileExt); Type:= neo;   END; INC(i);
  160.     WITH KnownFileTypes[i] DO Assign('DOO',FileExt); Type:= doodle;END; INC(i);
  161.     WITH KnownFileTypes[i] DO Assign('PC1',FileExt); Type:= smalldegas;END; INC(i);
  162.     WITH KnownFileTypes[i] DO Assign('PC2',FileExt); Type:= smalldegas;END; INC(i);
  163.     WITH KnownFileTypes[i] DO Assign('PC3',FileExt); Type:= smalldegas;END; INC(i);
  164.     WITH KnownFileTypes[i] DO Assign('PIC',FileExt); Type:= logo; END; INC(i);
  165.   END InitKnownFileTypes;
  166.  
  167.  
  168. (*-----------------------------------------------------------------------*)
  169. (*  Given a file extension return picture type                           *)
  170. (*-----------------------------------------------------------------------*)
  171.  
  172. PROCEDURE QueryPictureType( Ext : ARRAY OF CHAR ) : PicTypes;
  173.   VAR i : CARDINAL;
  174.       fext : FileExtStr;
  175.   BEGIN
  176.     i := 0;
  177.     Assign(Ext, fext);
  178.     WHILE ( KnownFileTypes[i].FileExt <> fext )
  179.     AND   ( KnownFileTypes[i].FileExt[0] <> 0C ) DO
  180.        INC(i);
  181.     END;
  182.         
  183.     RETURN  KnownFileTypes[i].Type;
  184.   END QueryPictureType;
  185.  
  186.  
  187. (*----------------------------------------------------------------------*)
  188. (*    Try to find and load the file given a name & where to put it      *)
  189. (*----------------------------------------------------------------------*)
  190.  
  191. (* these routines should be able to make it easier to load different
  192.    types of files                               *)
  193.  
  194. PROCEDURE OpenFile( VAR fnstr : String; VAR filesize : LONGCARD) : INTEGER;
  195.   VAR handle  : INTEGER;
  196.   BEGIN
  197.     filesize := 0;
  198.     handle := GemDos.Fopen(0, ADR(fnstr));
  199.     IF ( handle <= 0 ) THEN RETURN handle END; (* file not found *)
  200.  
  201.     filesize := GemDos.Fseek(2, handle, LONGCARD(0) ) ;
  202.     IF GemDos.Fseek(0, handle, LONGCARD(0) ) = 0 THEN END;
  203.     RETURN handle;
  204.   END OpenFile;
  205.  
  206.  
  207. PROCEDURE CloseFile( handle : INTEGER );
  208.   BEGIN
  209.     IF GemDos.Fclose( handle ) < 0 THEN END;
  210.   END CloseFile;
  211.  
  212.  
  213. PROCEDURE ReadFile( handle : INTEGER;
  214.                     destaddr : ADDRESS; size : LONGCARD ) : BOOLEAN;
  215.   BEGIN
  216.     RETURN ( GemDos.Fread( destaddr, size, handle ) = LONGINT(size) );
  217.   END ReadFile;
  218.  
  219.  
  220. PROCEDURE SetFilePos( handle : INTEGER; pos : LONGCARD ) : BOOLEAN; 
  221.   BEGIN
  222.     RETURN ( GemDos.Fseek(2, handle, pos ) = pos ) ;
  223.   END SetFilePos;
  224.  
  225. (*---------------------------------------------------------------------*)
  226. (* Load the files...                                                   *)
  227. (*---------------------------------------------------------------------*)
  228.  
  229. PROCEDURE LoadTny ( VAR fnstr       : String;
  230.                     VAR infile      : ARRAY OF CHAR ) : BOOLEAN;
  231.   VAR 
  232.       Filelen, duml : LONGCARD;
  233.       handle  : INTEGER;
  234.       reply   : BOOLEAN;
  235.   BEGIN
  236.     handle := OpenFile( fnstr, Filelen );
  237.     IF ( handle < 0 ) THEN 
  238.        RETURN FALSE;
  239.     ELSIF ( Filelen < 10  ) THEN 
  240.       CloseFile( handle );
  241.       RETURN FALSE;
  242.    END; (* wrong size *)
  243.                                                       
  244.     (* load the file using GemDos block read *)
  245.     reply := ReadFile( handle,  ADR(infile), Filelen );
  246.     CloseFile( handle );
  247.     RETURN reply;
  248.   END LoadTny;
  249.  
  250.  
  251. PROCEDURE LoadDegas ( VAR fnstr       : String;
  252.                           VAR picture : DegasPicture ) : BOOLEAN;
  253.   VAR 
  254.       Filelen, duml : LONGCARD;
  255.       handle  : INTEGER;
  256.       reply   : BOOLEAN;
  257.   BEGIN
  258.     handle := OpenFile( fnstr, Filelen );
  259.     IF ( handle < 0 ) THEN 
  260.        RETURN FALSE;
  261.     ELSIF ( Filelen < SIZE(picture) )  THEN
  262.        CloseFile( handle );
  263.        RETURN FALSE
  264.     END; (* wrong size *)
  265.                                                       
  266.     (* load the file using GemDos block read *)
  267.     reply := ReadFile( handle,  ADR(picture), SIZE(picture) );
  268.     CloseFile( handle );
  269.     RETURN reply;
  270.  END LoadDegas;
  271.  
  272.  
  273. PROCEDURE LoadDoodle ( VAR fnstr       : String;
  274.                        VAR picture     : DegasPicture ) : BOOLEAN;
  275.   VAR 
  276.       Filelen, duml : LONGCARD;
  277.       handle  : INTEGER;
  278.       reply   : BOOLEAN;
  279.   BEGIN
  280.     handle := OpenFile( fnstr, Filelen );
  281.     IF ( handle < 0 ) THEN
  282.        RETURN FALSE; 
  283.     ELSIF ( Filelen <> SIZE(picture.HiResPicture) )  THEN
  284.        CloseFile( handle );
  285.        RETURN FALSE
  286.        END; (* wrong size *)
  287.                                                       
  288.     (* load the file using GemDos block read *)
  289.     reply := ReadFile( handle,  ADR(picture.HiResPicture), Filelen ) ;
  290.     CloseFile( handle );
  291.     (* fake up a palette *)
  292.     picture.resolution := 2;
  293.     picture.HiPalette[0] := 0; (* white *)
  294.     RETURN reply;
  295.    END LoadDoodle;
  296.  
  297.  
  298. PROCEDURE LoadNeo ( VAR fnstr       : String;
  299.                     VAR picture     : DegasPicture ) : BOOLEAN;
  300.   VAR 
  301.       Filelen, duml : LONGCARD;
  302.       handle  : INTEGER;
  303.       reply   : BOOLEAN;
  304.   BEGIN
  305.     handle := OpenFile( fnstr, Filelen );
  306.     IF ( handle < 0 ) THEN 
  307.        RETURN FALSE;
  308.     ELSIF ( Filelen <= SIZE(picture) )  THEN
  309.        CloseFile( handle );
  310.        RETURN FALSE;
  311.        END; (* wrong size *)
  312.                                                       
  313.     (* load the file using GemDos block read *)
  314.     reply := ReadFile( handle,  ADR(picture.LowPalette), 128 ) ;
  315.     IF NOT reply  THEN RETURN reply END;
  316.     reply := ReadFile( handle,  ADR(picture.HiResPicture),
  317.                SIZE(picture.HiResPicture ));
  318.     CloseFile( handle );
  319.     (* set resolution *)
  320.     picture.resolution := 0;
  321.     RETURN reply;
  322.    END LoadNeo;
  323.  
  324.  
  325. PROCEDURE LoadUnknown ( VAR fnstr       : String;
  326.                         VAR picture     : DegasPicture ) : BOOLEAN;
  327.   VAR 
  328.       Filelen, duml : LONGCARD;
  329.       handle  : INTEGER;
  330.       reply   : BOOLEAN;
  331.   BEGIN
  332.     handle := OpenFile( fnstr, Filelen );
  333.     IF ( handle < 0 ) THEN 
  334.        RETURN FALSE;
  335.     ELSIF ( Filelen <> SIZE(picture) )  THEN
  336.        CloseFile( handle );
  337.        RETURN FALSE
  338.        END; (* wrong size *)
  339.                                                       
  340.     (* load the file using GemDos block read *)
  341.     reply := ReadFile( handle,  ADR(picture), SIZE(picture) ) ;
  342.     CloseFile( handle );
  343.     RETURN reply;
  344.    END LoadUnknown;
  345.  
  346.  
  347. (*-----------------------------------------------------------------------*)
  348. (*          Save an area to a File                                       *)
  349. (*-----------------------------------------------------------------------*)
  350. PROCEDURE SaveFile ( VAR fnstr       : String;
  351.                          sourceaddr  : ADDRESS;
  352.                          fsize       : LONGCARD ) : BOOLEAN;
  353.  
  354.   VAR BytesWritten : LONGCARD;
  355.       Filelen      : LONGCARD;
  356.       s            : String;
  357.       button       : INTEGER;
  358.       handle, dumi : INTEGER;
  359.   BEGIN
  360.     handle := GemDos.Fopen(0, ADR(fnstr));
  361.     IF handle >= 0 THEN
  362.         dumi   := GemDos.Fclose(handle);
  363.     END;
  364.     IF handle > 0  THEN
  365.        Concat('About to OVERWRITE ',fnstr,s);
  366.        button := ShowAlert(s,2,2);
  367.        IF button = 2 THEN RETURN FALSE END;
  368.     ELSE
  369.        handle := GemDos.Fcreate(0, ADR(fnstr));
  370.        IF handle < 0 THEN 
  371.           Concat('Unable to Create... |',fnstr,s);
  372.           button := ShowAlert(s,1,1);
  373.           RETURN FALSE;
  374.        END;
  375.        dumi := GemDos.Fclose(handle);
  376.     END; (* file not found *)
  377.    
  378.    (* save the file *)
  379.     handle := GemDos.Fopen( 2, ADR(fnstr) );
  380.     Filelen := GemDos.Fwrite( sourceaddr, fsize, handle );
  381.     IF ( GemDos.Fclose( handle ) <  0 ) THEN
  382.           Concat('Unable to SAVE... |',fnstr,s);
  383.           button := ShowAlert(s,1,1);
  384.           RETURN FALSE;
  385.     END;
  386.  
  387.     IF ( Filelen <  fsize ) THEN
  388.           Concat('Unable to SAVE... |',fnstr,s);
  389.           button := ShowAlert(s,1,1);
  390.           RETURN FALSE;
  391.     END;
  392.  
  393.     RETURN TRUE;
  394.    END SaveFile;
  395.  
  396.  
  397. (*----------------------------------------------------------------------*)
  398. (* Utility Routines for Picture Expansion.                              *)
  399. (*----------------------------------------------------------------------*)
  400.  
  401. PROCEDURE InsertChar(     res, lineno, pixelgroup : CARDINAL;
  402.                   plane : BitPlanesEnum; 
  403.               charno: CARDINAL;
  404.               c     : CHAR;
  405.               VAR pic   : DegasPicture);
  406.   BEGIN 
  407.     CASE res OF
  408.       LowRes : pic.LowResCharPicture[lineno][pixelgroup][plane][charno]:=c;|
  409.       MedRes : pic.MedResCharPicture[lineno][pixelgroup][plane][charno]:=c;|
  410.       HiRes  : pic.HiResCharPicture[lineno][pixelgroup][charno]:=c;|
  411.     END;
  412.   END InsertChar;
  413.  
  414.  
  415. PROCEDURE InsertWord(     res, lineno, pixelgroup  : CARDINAL;
  416.                   plane : BitPlanesEnum; 
  417.               w     : CARDINAL ;
  418.               VAR pic   : DegasPicture);
  419.   BEGIN
  420.     CASE res OF
  421.       LowRes : pic.LowResPicture[lineno][pixelgroup][plane]:=BITSET(w);|
  422.       MedRes : pic.MedResPicture[lineno][pixelgroup][plane]:=BITSET(w);|
  423.       HiRes  : pic.HiResPicture[lineno][pixelgroup]:=BITSET(w);|
  424.     END;
  425.   END InsertWord;
  426.  
  427.  
  428. PROCEDURE CharToInt( c : CHAR ) : INTEGER;
  429.   VAR i : INTEGER;
  430.   BEGIN
  431.      i := ORD(c);
  432.      IF i > 127 THEN
  433.         i := i - 256;
  434.      END;
  435.      RETURN i;
  436.   END CharToInt;
  437.  
  438.  
  439. PROCEDURE GetNextChar( VAR s : ARRAY OF CHAR; 
  440.                        VAR index : CARDINAL ) : CHAR;
  441.   VAR c : CHAR;
  442.   BEGIN
  443.     c := s[index];
  444.     INC(index);
  445.     RETURN( c );    
  446.   END GetNextChar;
  447.  
  448.  
  449. PROCEDURE GetNextCard( VAR s : ARRAY OF CHAR; VAR index : CARDINAL; ) : CARDINAL;
  450.   VAR c    : CARDINAL;
  451.   BEGIN
  452.     c := ORD(s[index]) * 256;
  453.     INC(index);
  454.     c := c + ORD(s[index]);
  455.     INC(index);
  456.     RETURN c;    
  457.   END GetNextCard;
  458.  
  459.  
  460.  
  461. (*----------------------------------------------------------------------*)
  462. (*  Convert LOGO pictures.                                              *)
  463. (*----------------------------------------------------------------------*)
  464.  
  465. (*----------------------------------------------------------------------*)
  466. (*  Format: word  Description                                           *)
  467. (*           0    Number of planes                                      *)
  468. (*           1    x-coordinate of picture                               *)
  469. (*           2    y-coordinate of picture                               *)
  470. (*           3    width in pixels of picture                            *)
  471. (*           4    height of picture in pixels                           *)
  472. (*           5... data                                                  *)
  473. (*                                                                      *)
  474. (*    Data: Each scanline is saved sequentially and padded to a         *)
  475. (*          pixel group boundary ( 16 pixels ).                         *)
  476. (*----------------------------------------------------------------------*)
  477.  
  478. PROCEDURE ConvertLOGO( VAR buffer   : ARRAY OF CHAR;
  479.                        VAR degaspic : DegasPicture ) : BOOLEAN;
  480.   VAR 
  481.     NLines                      : CARDINAL;
  482.     inchar    (* index into buffer *) : CARDINAL;
  483.  
  484.     command                   : INTEGER;
  485.  
  486.     curpixelgroup,
  487.     curline                : CARDINAL;
  488.         curplane            : BitPlanesEnum;
  489.     curcharno            : CARDINAL;
  490.     curmaxpixelgroup        : CARDINAL;
  491.         curmaxplane                     : BitPlanesEnum;
  492.  
  493.     (* Input details *)
  494.     xcoord, ycoord,
  495.     pixelw, pixelh,
  496.  
  497.     pixelgroupw,
  498.     startpixelgroup,
  499.     startline            : CARDINAL;
  500.     
  501.         card                : CARDINAL;
  502.         i,                 : CARDINAL;
  503.         pxw                : CARDINAL;
  504.         mask                : CARDINAL; 
  505.                 (* used to remove fringe *)
  506.     lastpixelword            : CARDINAL;
  507.  
  508.   BEGIN
  509.         ClearPicture(degaspic);
  510.     curline := 0;
  511.         curpixelgroup := 0;
  512.         curplane  := BitPlane1;
  513.  
  514.         inchar := 0;
  515.     card     := GetNextCard(buffer, inchar);
  516.     xcoord     := GetNextCard(buffer, inchar);
  517.     ycoord     := GetNextCard(buffer, inchar);
  518.     pixelw     := GetNextCard(buffer, inchar);
  519.     pixelh     := GetNextCard(buffer, inchar);
  520.     
  521.     pixelgroupw := ( pixelw DIV 16 ) + 1;
  522.  
  523.     CASE card OF
  524.        4      : NLines := 200;
  525.                    curmaxpixelgroup := HIGH(degaspic.LowResPicture[0]);
  526.                    curmaxplane      := BitPlane4;
  527.            degaspic.resolution := LowRes;
  528.            startline        := ( LowResMaxY - pixelh ) DIV 2;
  529.            startpixelgroup  := 
  530.             (( LowResMaxX - pixelw ) DIV 2) DIV BITSPERWORD;
  531.             |
  532.            2      : NLines := 200; 
  533.                    curmaxpixelgroup := HIGH(degaspic.MedResPicture[0]);
  534.                    curmaxplane      := BitPlane2;
  535.            degaspic.resolution := MedRes;
  536.            startline        := ( MedResMaxY - pixelh ) DIV 2;
  537.            startpixelgroup  := 
  538.             (( MedResMaxX - pixelw ) DIV 2) DIV BITSPERWORD;
  539.            |
  540.            1     : NLines := 400; 
  541.                    curmaxpixelgroup := HIGH(degaspic.HiResPicture[0]);
  542.                    curmaxplane      := BitPlane1;
  543.            degaspic.resolution := HiRes;
  544.            startline        := ( HiResMaxY - pixelh ) DIV 2;
  545.            startpixelgroup  := 
  546.             (( HiResMaxX - pixelw ) DIV 2) DIV BITSPERWORD;
  547.            |
  548.     ELSE
  549.       RETURN FALSE;
  550.         END;
  551.  
  552.         FOR i := 0 TO 15 DO (* mono palette *)
  553.       degaspic.LowPalette[i] := 0H;
  554.         END;
  555.     degaspic.LowPalette[0] := 0777H
  556.  
  557.     (* set mask for fringe in final 16 bit pixels *)
  558.     mask := 0FFFFH;
  559.         card := 1;
  560.     FOR i := 0 TO ( pixelw MOD BITSPERWORD ) DO
  561.        mask := mask - card;
  562.            card := card * 2;
  563.         END;    
  564.  
  565.     lastpixelword := startpixelgroup + pixelgroupw - 1;
  566.  
  567.     FOR curline := startline TO startline + pixelh - 1 DO
  568.       FOR curpixelgroup := startpixelgroup TO lastpixelword DO
  569.             FOR curplane := BitPlane1 TO curmaxplane DO 
  570.           card := GetNextCard(buffer, inchar);
  571.           IF curpixelgroup = lastpixelword THEN
  572.                  card := IAND(card,mask);
  573.               END;
  574.            InsertWord( degaspic.resolution, 
  575.                   curline, curpixelgroup, curplane,
  576.                   card,
  577.                   degaspic);
  578.         END;
  579.           END;
  580.         END;
  581.  
  582.         RETURN TRUE;          
  583.   END ConvertLOGO;
  584.  
  585.  
  586. (*----------------------------------------------------------------------*)
  587. (*  Convert Compressed DEGAS                                            *)
  588. (*----------------------------------------------------------------------*)
  589.  
  590. PROCEDURE ConvertPC( VAR buffer   : ARRAY OF CHAR;
  591.                      VAR degaspic : DegasPicture ) : BOOLEAN;
  592.   VAR 
  593.     NLines                      : CARDINAL;
  594.     inchar    (* index into buffer *) : CARDINAL;
  595.  
  596.     command                   : INTEGER;
  597.  
  598.     curpixelgroup,
  599.     curline                : CARDINAL;
  600.         curplane            : BitPlanesEnum;
  601.     curcharno            : CARDINAL;
  602.     curmaxpixelgroup        : CARDINAL;
  603.         curmaxplane                     : BitPlanesEnum;
  604.  
  605.         ch                : CHAR;
  606.         card                : CARDINAL;
  607.         i                 : CARDINAL;
  608.         nchars                : CARDINAL;
  609.  
  610.   PROCEDURE NextPlane;
  611.     BEGIN
  612.       IF curplane = curmaxplane THEN
  613.          curplane := BitPlane1;
  614.       ELSE
  615.          INC(curplane);
  616.       END;
  617.     END NextPlane;
  618.  
  619.  
  620. PROCEDURE NextPixelGroup;
  621.   BEGIN
  622.     INC(curpixelgroup);
  623.     IF curpixelgroup > curmaxpixelgroup THEN
  624.        IF curplane = curmaxplane THEN
  625.           INC(curline);
  626.           curplane := BitPlane1;
  627.        ELSE
  628.           NextPlane;
  629.        END;
  630.        curpixelgroup := 0;
  631.     END;
  632.   END NextPixelGroup;
  633.  
  634.   
  635.   PROCEDURE NextCharno;
  636.     BEGIN
  637.       IF curcharno = 0 THEN
  638.          INC(curcharno);
  639.       ELSE
  640.          curcharno := 0;
  641.          NextPixelGroup;
  642.       END;
  643.     END NextCharno;
  644.  
  645. (* continue filling picture by repeating character, nchars times *)
  646.   PROCEDURE ScanLineRepeat( nchars : CARDINAL; ch : CHAR );
  647.     BEGIN
  648.       WHILE nchars > 0 DO
  649.     InsertChar( degaspic.resolution, 
  650.             curline, curpixelgroup, curplane, curcharno,
  651.             ch,
  652.             degaspic);
  653.         NextCharno;
  654.         DEC(nchars);
  655.       END;
  656.     END ScanLineRepeat;
  657.  
  658. (* continue filling picture with nchars from the input *)
  659.   PROCEDURE ScanLineCopy( nchars : CARDINAL; );
  660.     VAR ch : CHAR;
  661.     BEGIN
  662.       WHILE nchars > 0 DO
  663.         ch := GetNextChar(buffer, inchar);
  664.      InsertChar( degaspic.resolution, 
  665.             curline, curpixelgroup, curplane, curcharno,
  666.             ch,
  667.             degaspic);
  668.         NextCharno;
  669.         DEC(nchars);
  670.       END;
  671.     END ScanLineCopy;
  672.  
  673.  
  674.   BEGIN
  675.     curline := 0;
  676.         curpixelgroup := 0;
  677.         curcharno := 0;
  678.         curplane  := BitPlane1;
  679.         
  680.         inchar := 0;
  681.     card := GetNextCard(buffer, inchar);
  682.         card := IAND( card, INTEGER(08003H));
  683.     CASE card OF
  684.       08000H : NLines := 200;
  685.                    curmaxpixelgroup := HIGH(degaspic.LowResPicture[0]);
  686.                    curmaxplane      := BitPlane4;
  687.            degaspic.resolution := LowRes;     |
  688.           08001H : NLines := 200; 
  689.                    curmaxpixelgroup := HIGH(degaspic.MedResPicture[0]);
  690.                    curmaxplane      := BitPlane2;
  691.            degaspic.resolution := MedRes;    |
  692.           08002H : NLines := 400; 
  693.                    curmaxpixelgroup := HIGH(degaspic.HiResPicture[0]);
  694.                    curmaxplane      := BitPlane1;
  695.            degaspic.resolution := HiRes;    |
  696.     ELSE
  697.       RETURN FALSE;
  698.         END;
  699.  
  700.     FOR i := 0 TO 15 DO
  701.       degaspic.LowPalette[i] := GetNextCard(buffer, inchar);
  702.         END;
  703.  
  704.     LOOP
  705.           IF curline >= NLines THEN EXIT; END;
  706.  
  707.           command := CharToInt(GetNextChar(buffer, inchar));
  708.           IF command > 0 THEN
  709.              ScanLineCopy( command+1 );
  710.  
  711.           ELSIF command > -127 THEN
  712.              nchars := ABS(command) + 1;
  713.              ch := GetNextChar(buffer, inchar);
  714.              ScanLineRepeat( nchars, ch); 
  715.           END;
  716.         END;
  717.         RETURN TRUE;          
  718.   END ConvertPC;
  719.  
  720. (*----------------------------------------------------------------------*)
  721. (* Convert Tiny picture to Degas                                        *)
  722. (*----------------------------------------------------------------------*)
  723.  
  724. (*----------------------------------------------------------------------*)
  725. (* The documentation issued with the 'Tinypic' program explaining the   *)
  726. (* layout of the compressed file is incorrect in one or two details.    *)
  727. (* The layout for the compressed file is:-                              *)
  728. (*                                                                      *)
  729. (*     Size ( bytes )   description                                     *)
  730. (*        1             picture resolution ( +3 if rotation info )      *)
  731. (*        4             rotation info if res >= 3                       *)
  732. (*       32             palette                                         *)
  733. (*        2             count of control BYTES                          *)
  734. (*        2             count of data WORDS                             *)
  735. (*        n control bytes                                               *)
  736. (*        n data words                                                  *)
  737. (*                                                                      *)
  738. (*  The compressed data was produced by scanning the data in a degas    *)
  739. (*  picture as follows:                                                 *)
  740. (*                                                                      *)
  741. (*     1) Each colour plane is processed in turn, i.e. all plane 1      *)
  742. (*        is processed before plane 2.                                  *)
  743. (*                                                                      *)
  744. (*     2) Each plane is processed in vertical columns of words.         *)
  745. (*                                                                      *)
  746. (*----------------------------------------------------------------------*)
  747.  
  748. PROCEDURE ConvertTny( VAR buffer   : ARRAY OF CHAR;
  749.                       VAR degaspic : DegasPicture ) : BOOLEAN;
  750.   VAR 
  751.     NLines                      : CARDINAL;
  752.     incomchar (* index into buffer *),
  753.     indatachar                : CARDINAL;
  754.  
  755.     command                   : INTEGER;
  756.  
  757.     curpixelgroup,
  758.     curline                : CARDINAL;
  759.         curplane            : BitPlanesEnum;
  760.     curmaxpixelgroup        : CARDINAL;
  761.         curmaxplane                     : BitPlanesEnum;
  762.  
  763.     incomcount,
  764.     indatacount            : CARDINAL;
  765.     picres                : CARDINAL;
  766.  
  767.         ch                : CHAR;
  768.         card                : CARDINAL;
  769.         i                 : CARDINAL;
  770.         nchars                : CARDINAL;
  771.         
  772.  
  773.   PROCEDURE NextPlane; (* slowest *)
  774.     BEGIN
  775.       IF curplane = curmaxplane THEN
  776.          curplane := BitPlane1;
  777.       ELSE
  778.          INC(curplane);
  779.       END;
  780.     END NextPlane;
  781.  
  782.  
  783. PROCEDURE NextPixelGroup; (* next fastest *)
  784.   BEGIN
  785.     INC(curpixelgroup);
  786.     IF curpixelgroup > curmaxpixelgroup THEN
  787.        IF curplane = curmaxplane THEN
  788.           RETURN;
  789.        ELSE
  790.           NextPlane;
  791.           curpixelgroup := 0;
  792.        END;
  793.     END;
  794.   END NextPixelGroup;
  795.  
  796.  
  797. PROCEDURE NextLine; (* changes fastest *)
  798.   BEGIN
  799.     INC(curline);
  800.     IF curline >= NLines THEN
  801.        NextPixelGroup;
  802.        curline := 0;
  803.     END;
  804.   END NextLine;  
  805.  
  806.  
  807.   PROCEDURE ScanLineRepeat( nchars : CARDINAL; word : CARDINAL );
  808.     BEGIN
  809.       WHILE nchars > 0 DO
  810.     InsertWord( degaspic.resolution, 
  811.             curline, curpixelgroup, curplane, 
  812.             word,
  813.             degaspic);
  814.         NextLine;
  815.         DEC(nchars);
  816.       END;
  817.     END ScanLineRepeat;
  818.  
  819.  
  820.   PROCEDURE ScanLineCopy( nchars : CARDINAL; );
  821.     VAR word : CARDINAL;
  822.     BEGIN
  823.       WHILE nchars > 0 DO
  824.         word := GetNextCard(buffer, indatachar);
  825.      InsertWord( degaspic.resolution, 
  826.             curline, curpixelgroup, curplane,
  827.             word,
  828.             degaspic);
  829.         NextLine;
  830.         DEC(nchars);
  831.       END;
  832.     END ScanLineCopy;
  833.  
  834.  
  835.   BEGIN
  836.     curline := 0;
  837.         curpixelgroup := 0;
  838.         curplane  := BitPlane1;
  839.         
  840.         incomchar := 0;
  841.         indatachar := 0;
  842.  
  843.         picres := CharToInt(GetNextChar(buffer, incomchar));
  844.         IF picres >= 3 THEN (* has rotation info - 4 bytes *)
  845.               DEC(picres, 3);
  846.            FOR i := 0 TO 3 DO
  847.              ch := GetNextChar(buffer,incomchar);
  848.            END; (* for *)
  849.         END;
  850.  
  851.     degaspic.resolution := LowRes; (* patch *)
  852.  
  853.     CASE degaspic.resolution OF
  854.       LowRes, MedRes, HiRes
  855.          : NLines := 200;
  856.                    curmaxpixelgroup := HIGH(degaspic.LowResPicture[0]);
  857.                    curmaxplane      := BitPlane4; |
  858.         END;
  859.     FOR i := 0 TO 15 DO
  860.       degaspic.LowPalette[i] := GetNextCard(buffer, incomchar);
  861.         END;
  862.  
  863.     incomcount  := GetNextCard(buffer, incomchar);
  864.     indatacount := GetNextCard(buffer, incomchar);
  865.     indatachar  := incomchar + incomcount;
  866.  
  867.     LOOP
  868.           IF incomcount = 0 THEN EXIT; END;
  869.  
  870.           command := CharToInt(GetNextChar(buffer, incomchar));
  871.           DEC(incomcount);
  872.  
  873.           IF command < 0 THEN
  874.              nchars := ABS(command);
  875.              ScanLineCopy( nchars );
  876.  
  877.       ELSIF command = 1 THEN
  878.          nchars := GetNextCard(buffer, incomchar);
  879.          DEC(incomcount,2);
  880.              ScanLineCopy( nchars );
  881.  
  882.           ELSIF command > 1 THEN
  883.              nchars := ABS(command);
  884.              ScanLineRepeat( nchars, GetNextCard(buffer, indatachar) );
  885.  
  886.       ELSIF command = 0 THEN
  887.          nchars := GetNextCard(buffer, incomchar);
  888.          DEC(incomcount,2);
  889.              ScanLineRepeat( nchars, GetNextCard(buffer, indatachar) );
  890.           END;
  891.         END;
  892.     degaspic.resolution := picres;
  893.         RETURN TRUE;          
  894.   END ConvertTny;
  895.  
  896.  
  897. (*----------------------------------------------------------------------*)
  898. (*                     Library Routines                                 *)
  899. (*----------------------------------------------------------------------*)
  900.  
  901. PROCEDURE LoadDegasFile( VAR picture : DegasPicture ;
  902.                          VAR fname   : String        ) : BOOLEAN;
  903.   VAR
  904.  
  905.     FileExt     : FileExtStr;
  906.     cpathname, pdrive, pfpath, pfname : String;
  907.     fileloaded  : BOOLEAN;
  908.     filelen     : LONGCARD;
  909.     InTnyFile   : TnyFilePtr;
  910.  
  911.   BEGIN
  912.     NullFill(pfpath);
  913.     NullFill(cpathname);
  914.     ShowMouse;
  915.     fileloaded := GetFilename('*',
  916.                               pfpath,
  917.                               LastFilename,
  918.                               cpathname);
  919.     HideMouse;
  920.     IF NOT fileloaded THEN 
  921.       RETURN fileloaded;
  922.     END; (* cancel or empty filename *)
  923.  
  924.     ParseFilePath( cpathname, pdrive, pfpath, pfname, FileExt );
  925.     CASE QueryPictureType( FileExt ) OF
  926.       tny    : IF NOT Available(CMaxTnyFile) THEN    
  927.                   IF ShowAlert('NO Room for TNY buffer',1,1) = 0 THEN END;
  928.                   RETURN FALSE;
  929.                 END;
  930.                 ALLOCATE(InTnyFile, CMaxTnyFile);
  931.                 IF InTnyFile = NIL THEN
  932.                   IF ShowAlert('NO Room for InTnyFile',1,1) = 0 THEN END;
  933.                 END;
  934.                 fileloaded :=  LoadTny(cpathname, InTnyFile^ );
  935.                 IF fileloaded THEN
  936.                    fileloaded := ConvertTny( InTnyFile^, picture );
  937.                 END; (* if *)                    
  938.                 DEALLOCATE(InTnyFile, CMaxTnyFile);          |
  939.  
  940.       smalldegas
  941.            : IF NOT Available(CMaxTnyFile) THEN    
  942.                   IF ShowAlert('NO Room for PC buffer',1,1) = 0 THEN END;
  943.                   RETURN FALSE;
  944.                 END;
  945.                 ALLOCATE(InTnyFile, CMaxTnyFile);
  946.                 IF InTnyFile = NIL THEN
  947.                   IF ShowAlert('NO Room for PC',1,1) = 0 THEN END;
  948.                 END;
  949.                 fileloaded :=  LoadTny(cpathname, InTnyFile^ );
  950.                 IF fileloaded THEN
  951.                    fileloaded := ConvertPC( InTnyFile^, picture );
  952.                 END; (* if *)                    
  953.                 DEALLOCATE(InTnyFile, CMaxTnyFile);          |
  954.  
  955.       logo
  956.            : IF NOT Available(CMaxTnyFile) THEN    
  957.                   IF ShowAlert('NO Room for logo buffer',1,1) = 0 THEN END;
  958.                   RETURN FALSE;
  959.                 END;
  960.                 ALLOCATE(InTnyFile, CMaxTnyFile);
  961.                 IF InTnyFile = NIL THEN
  962.                   IF ShowAlert('NO Room for logo',1,1) = 0 THEN END;
  963.                 END;
  964.                 fileloaded :=  LoadTny(cpathname, InTnyFile^ );
  965.                 IF fileloaded THEN
  966.                    fileloaded := ConvertLOGO( InTnyFile^, picture );
  967.                 END; (* if *)                    
  968.                 DEALLOCATE(InTnyFile, CMaxTnyFile);          |
  969.  
  970.       degas  :  fileloaded := LoadDegas(cpathname, picture);  |
  971.  
  972.       neo    :  fileloaded := LoadNeo( cpathname, picture );  |
  973.  
  974.       doodle :  fileloaded := LoadDoodle( cpathname, picture );  
  975.  
  976.     ELSE
  977.              fileloaded :=  LoadUnknown( cpathname, picture ) ;
  978.     END;
  979.  
  980.     fname := cpathname;
  981.     RETURN fileloaded;
  982.   END LoadDegasFile;
  983.  
  984.  
  985. PROCEDURE SaveDegasFile( VAR picture : DegasPicture ) : BOOLEAN ;
  986.   CONST
  987.     Defext = 'PI3';
  988.   VAR
  989.     sfn, pname, cpathname : String;
  990.     filesaved      : BOOLEAN;
  991.     button, i      : INTEGER;
  992.   BEGIN
  993.     NullFill(pname);
  994.     NullFill(sfn);
  995.     NullFill(cpathname);
  996.     Assign(LastFilename, sfn);
  997.     IF sfn[0] # 0C THEN
  998.        i := 13;
  999.        WHILE ( i > 1 ) & ( sfn[i] = 0C ) DO DEC(i) END;
  1000.        IF sfn[i] # '3' THEN
  1001.           sfn[i]   := '3';
  1002.           sfn[i-1] := 'I';
  1003.           sfn[i-2] := 'P';
  1004.        END;
  1005.  
  1006.     END;
  1007.     ShowMouse;
  1008.     filesaved :=GetFilename(Defext, pname, sfn, cpathname);
  1009.     IF NOT filesaved THEN
  1010.        RETURN FALSE 
  1011.     END; (* cancel or empty filename *)
  1012.  
  1013.     (* check the extension *)
  1014.     i := 0;
  1015.     WHILE ( i < 65 ) & ( cpathname[i] > 0C ) DO INC(i) END;
  1016.     IF i < 4 THEN RETURN FALSE END; (* damn strange file name *)
  1017.     DEC(i);
  1018.     IF ( cpathname[i-3] = '.' ) THEN
  1019.        i := i - 4; (* last char of name *)
  1020.     END;
  1021.     (* assume no extension added.. must write a decent validation routine *)
  1022.     INC(i); 
  1023.     cpathname[i] := 0C;
  1024.     Concat(cpathname,'.PI3',cpathname); 
  1025.  
  1026.     filesaved := SaveFile(cpathname, ADR(picture), SIZE(picture));
  1027.     RETURN filesaved;
  1028.   END SaveDegasFile;
  1029.  
  1030.  
  1031. (*----------------------------------------------------------------------*)
  1032. (* Save the '.IMG' File.                                                *)
  1033. (*----------------------------------------------------------------------*)
  1034.  
  1035. PROCEDURE SaveImageFile( IMGLen     : CARDINAL;
  1036.                          IMGFilePtr : ADDRESS ) : BOOLEAN;
  1037.   VAR
  1038.     FileExt     : FileExtStr;
  1039.     cpathname, pdrive, pfpath, pfname : String;
  1040.     sfn            : String;
  1041.     filesaved      : BOOLEAN;
  1042.     button, i      : INTEGER;
  1043.   BEGIN
  1044.     NullFill(pfpath);
  1045.     NullFill(sfn);
  1046.     NullFill(cpathname);
  1047.     Assign(LastFilename,sfn);
  1048.     IF sfn[0] # 0C THEN
  1049.        i := 13;
  1050.        WHILE ( i > 1 ) & ( sfn[i] = 0C ) DO DEC(i) END;
  1051.        IF sfn[i] # 'G' THEN
  1052.           sfn[i-2] := 'I';
  1053.           sfn[i-1] := 'M';
  1054.           sfn[i]   := 'G';
  1055.        END;
  1056.  
  1057.     END;
  1058.     ShowMouse;
  1059.     filesaved :=GetFilename('IMG', pfpath, sfn, cpathname);
  1060.     IF NOT filesaved THEN
  1061.        RETURN FALSE 
  1062.     END; (* cancel or empty filename *)
  1063.  
  1064.     (* check the extension *)
  1065.     ParseFilePath( cpathname, pdrive, pfpath, pfname, FileExt );
  1066.     NullFill(cpathname);
  1067.     Assign(pdrive,cpathname);
  1068.     Concat(cpathname,':',cpathname);
  1069.     Concat(cpathname, pfpath ,cpathname);
  1070.     Concat(cpathname, pfname ,cpathname);
  1071.     (* assume no extension added.. must write a decent validation routine *)
  1072.     Concat(cpathname,'.IMG',cpathname);
  1073.  
  1074.     filesaved := SaveFile(cpathname, IMGFilePtr, LONG(IMGLen));
  1075.     RETURN filesaved;
  1076.   END SaveImageFile;
  1077.  
  1078.  
  1079. BEGIN
  1080.   LastFilename := 0C;
  1081.   InitKnownFileTypes;
  1082.  
  1083. END DCFileIO.